home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyWindowsMenu.p < prev    next >
Encoding:
Text File  |  1996-05-31  |  2.9 KB  |  139 lines  |  [TEXT/CWIE]
  1. unit MyWindowsMenu;
  2.  
  3. interface
  4.  
  5.     procedure StartupWindowsMenu;
  6.     procedure UpdateWindowsMenu;
  7.     function DoWindowsMenuItem (themenu, theitem: integer): boolean;
  8.  
  9. implementation
  10.  
  11.     uses
  12.         Fonts, MyFMenus, MyTypes, MyStartup, MyMenus, MyOOMainLoop, MyStrings;
  13.  
  14.     var
  15.         menu: MenuHandle;
  16.         skip, base: integer;
  17.         wason: boolean;
  18.  
  19.     function GetNextWindow (var wp: WindowPeek): boolean;
  20.     begin
  21.         if wp = nil then begin
  22.             wp := WindowPeek(FrontWindow);
  23.         end else begin
  24.             wp := wp^.nextWindow;
  25.         end;
  26.         while (wp <> nil) & (not wp^.visible | (GetWType(WindowPtr(wp)) = WT_NotMine)) do begin
  27.             wp := wp^.nextWindow;
  28.         end;
  29.         GetNextWindow := wp <> nil;
  30.     end;
  31.  
  32.     procedure SetEnableMenu (on: boolean);
  33.     begin
  34.         if (skip > 0) then begin
  35.             SetFMenu(M_Windows);
  36.             if (BAND(menu^^.enableFlags, BSL(1, skip) - 1) <> 0) then begin
  37.                 on := true;
  38.             end;
  39.         end;
  40.         if wason <> on then begin
  41.             wason := on;
  42.             SetItemEnable(menu, 0, on);
  43.             DrawMenuBar;
  44.         end;
  45.     end;
  46.  
  47.     procedure UpdateWindowsMenu;
  48.         var
  49.             wp: WindowPeek;
  50.             title: Str255;
  51.             i: integer;
  52.             first: boolean;
  53.     begin
  54.         for i := CountMItems(menu) downto skip + 1 do begin
  55.             DeleteMenuItem(menu, i);
  56.         end;
  57.         wp := nil;
  58.         first := true;
  59.         while GetNextWindow(wp) do begin
  60.             if first and (skip > 0) then begin
  61.                 AppendMenu(menu, '(-');
  62.             end;
  63.             GetWTitle(WindowPtr(wp), title);
  64.             LimitStringLength(title, 40, '…');
  65.             SafeAppendMenu(menu, title);
  66.             if first & (WindowPtr(wp) = FrontWindow) then begin
  67.                 SetItemMark(menu, base, chr(checkMark));
  68.             end;
  69.             first := false;
  70.         end;
  71.         SetEnableMenu(not first);
  72.     end;
  73.  
  74.     function DoWindowsMenuItem (themenu, theitem: integer): boolean;
  75.         var
  76.             wp: WindowPeek;
  77.     begin
  78.         DoWindowsMenuItem := false;
  79.         if (themenu = M_Windows) and (theitem >= base) then begin
  80.             DoWindowsMenuItem := true;
  81.             wp := nil;
  82.             while (theitem >= base) do begin
  83.                 if not GetNextWindow(wp) then begin
  84.                     leave;
  85.                 end;
  86.                 theitem := theitem - 1;
  87.             end;
  88.             if wp <> nil then begin
  89.                 SelectWindow(WindowPtr(wp));
  90.             end;
  91.             HiliteMenu(0);
  92.         end;
  93.     end;
  94.  
  95.     procedure SetSendToBack(themenu,theitem:integer);
  96.         var
  97.             wp:WindowPeek;
  98.     begin
  99.         wp:=nil;
  100.         SetIDItemEnable(themenu, theitem, GetNextWindow(wp) & GetNextWindow(wp)); { At least two windows }
  101.     end;
  102.     
  103.     procedure DoSendToBack;
  104.         var
  105.             wp,first, last:WindowPeek;
  106.     begin
  107.         wp:=nil;
  108.         if GetNextWindow(wp) then begin
  109.             first := wp;
  110.             last:=nil;
  111.             while GetNextWindow(wp) do begin
  112.                 last := wp;
  113.             end;
  114.             if last<>nil then begin
  115.                 SendBehind(WindowPtr(first),WindowPtr(last));
  116.             end;
  117.         end;
  118.     end;
  119.     
  120.     function InitWindowsMenu( var msg: integer ): OSStatus;
  121.     begin
  122. {$unused(msg)}
  123.         menu := GetFMenu(M_Windows);
  124.         InsertMenu(menu, 0);
  125.         skip := CountMItems(menu);
  126.         base := skip + 1 + ord(skip > 0);
  127.         wason := true;
  128.         UpdateWindowsMenu;
  129.         SetFBoth('stbk', DoSendToBack, SetSendToBack);
  130.         InitWindowsMenu := noErr;
  131.     end;
  132.  
  133.     procedure StartupWindowsMenu;
  134.     begin
  135.         StartupFMenus;
  136.         SetStartup( InitWindowsMenu, nil, 0, nil );
  137.     end;
  138.  
  139. end.